home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / music / 7 / pascal / pasacc.doc < prev    next >
Text File  |  1985-11-19  |  11KB  |  294 lines
  1. WRITING DESK ACCESSORIES USING PERSONAL PASCAL
  2. ----------------------------------------------
  3.  
  4. In order to make a Personal Pascal program into a desk accessory, you must
  5. perform a few operations which are not described in the manual.  First of all,
  6. you must make sure your program can be made into an accessory as follows:
  7.  
  8. 1.  The start of your program should contain an S0 compiler directive.  This
  9.     command tells the compiler not to adjust the size of the stack.
  10.  
  11. 2.  You should NOT use debug mode.  Either change the option setting called
  12.     "Full debug mode", or use a D- command along with the S0 command.
  13.  
  14. 3.  The value actually returned by the Init_Gem routine is the application
  15.     identification number for your program.  You must save this number in a
  16.     variable, instead of just testing it.  Again, look at the sample accessory
  17.     for details.
  18.  
  19. 4.  Two additional GEM messages are sent to accessories.  These messages,
  20.     AC_Open and AC_Close, are not declared in the GEMCONST.PAS file.  You
  21.     should either declare them in your program (as the sample accessory does)
  22.     or add them to the GEMCONST.PAS include file.  You also must respond to
  23.     these messages as shown in the sample accessory.
  24.  
  25. 5.  You need to declare one more EXTERNAL function in your desk accessory
  26.     program:
  27.       FUNCTION Menu_Register( ap_id : integer ; VAR name : Str255 ) : integer ;
  28.         EXTERNAL ;
  29.     This function already appears in the PASGEM library, but it does not appear
  30.     in GEMSUBS.PAS (you can add it there, if you wish).  Use the Menu_Register
  31.     function to insert the name of your accessory in the "Desk" menu.  See the
  32.     sample accessory for details.
  33.  
  34. Next, you need to create a file called PASACC.O by running the MAKEACC.PAS
  35. program listed below.  You must enter a valid stack size; although you could
  36. use most any size, we recommend 5 Kbytes.  After creating the PASACC.O file,
  37. link your program as follows:
  38.  
  39. 1.  You must link PASACC.O as the first link file, not the object file produced
  40.     by your Pascal source program.  Put the name of your Pascal object program
  41.     in the "Additional Link Files" field of the link options dialog box.
  42.  
  43. 2.  Select the "Link..." item in the files menu.  When the ITEM SELECTOR dialog
  44.     appears, select the file PASACC.O-- remember, your program's .O file must
  45.     already be in the "Additional Link Files" list!
  46.  
  47. 3.  The linker should load and link your program normally.  The final output
  48.     file will be named PASACC.PRG.  Change this to any name, but give it the
  49.     extension ".ACC" (this tells GEM to load the accessory upon booting).  If
  50.     you have an early version of GEM/TOS, you may need to name your file
  51.     DESK3.ACC (the earliest version needed the "DESK#" primary name).
  52.  
  53. 4.  Copy your accessory file to a backup of your boot disk, and reboot your ST.
  54.     The name of your accessory should appear under the "Desk" menu.  If you
  55.     select your accessory, it should run.
  56.  
  57. LISTING OF MAKEACC.PAS
  58. ----------------------
  59.  
  60. PROGRAM Make_Accessory ;
  61.  
  62.   VAR
  63.     stack_size : Integer ;
  64.     answer : STRING ;
  65.  
  66.   PROCEDURE Write_Accstart( size : Integer ) ;
  67.  
  68.     VAR
  69.       f : FILE OF integer ;
  70.  
  71.     PROCEDURE Word( w : Integer ) ;
  72.  
  73.       BEGIN
  74.         f^ := w ;
  75.         put( f ) ;
  76.       END ;
  77.  
  78.     PROCEDURE Long( l : Long_Integer ) ;
  79.  
  80.       BEGIN
  81.         Word( Int(Shr( l, 16 )) ) ;
  82.         word( Int( l ) ) ;
  83.       END ;
  84.  
  85.     BEGIN
  86.       writeln( 'Opening PASACC.O...' ) ;
  87.       rewrite( f, 'pasacc.o' ) ;
  88.       writeln( 'Writing data...' ) ;
  89.       (* Put out the object file header: *)
  90.       Word( $601A ) ;
  91.       Long( $14 ) ;
  92.       Long( 0 ) ;
  93.       Long( size+4 ) ;
  94.       Long( 0 ) ;
  95.       Long( 0 ) ;
  96.       Long( 0 ) ;
  97.       Word( 0 ) ;
  98.       (* Now the code: *)
  99.       Word( $4FF9 ) ;       (* lea user_stack,sp *)
  100.       Long( size ) ;
  101.       Word( $41F9 ) ;       (* lea stack_start,a0 *)
  102.       Long( 0 ) ;
  103.       Word( $2248 ) ;       (* movea.l a0,a1 *)
  104.       Word( $4EF9 ) ;       (* jmp prg_start+12 *)
  105.       Long( $20 ) ;
  106.       (* Now the relocation information: *)
  107.       Word( 7 ) ;
  108.       Long( $50003 ) ;
  109.       Word( 7 ) ;
  110.       Long( $50003 ) ;
  111.       Word( 7 ) ;
  112.       Word( 7 ) ;
  113.       Long( $50002 ) ;
  114.       writeln( 'Finished!' ) ;
  115.     END ;
  116.  
  117.   BEGIN
  118.     REPEAT
  119.       write( 'How many Kbytes for desk accessory stack? ' ) ;
  120.       readln( stack_size ) ;
  121.       write( stack_size:1, ' Kbytes-- is this correct? ' ) ;
  122.       readln( answer ) ;
  123.     UNTIL (length(answer) > 0) AND ((answer[1] = 'y') OR (answer[1] = 'Y')) ;
  124.     IF ((answer[1] = 'y') OR (answer[1] = 'Y')) THEN
  125.       Write_Accstart( stack_size*1024 ) ;
  126.   END.
  127.  
  128. LISTING OF ACCDEMO.PAS (SAMPLE ACCESSORY)
  129. -----------------------------------------
  130.  
  131. (* We don't want any stack (PASACC.O takes care of the stack) and we certainly
  132.    shouldn't be in full debug mode! *)
  133.  
  134. (*$S0,D-*)
  135.  
  136. PROGRAM Sample_Accessory ;
  137.  
  138.   CONST
  139.     (*$I gemconst.pas*)
  140.     AC_Open  = 40 ;     (* Two new messages which only accessories will get. *)
  141.     AC_Close = 41 ;
  142.  
  143.   TYPE
  144.     (*$I gemtype.pas*)
  145.  
  146.   VAR
  147.     window,                     (* The handle of our window. *)
  148.     ap_id,                      (* Our application identification handle. *)
  149.     menu_id : integer ;         (* Index of our menu item in "Desk" menu. *)
  150.     our_name,                   (* The name of our accessory. *)
  151.     wind_name : Str255 ;        (* The title of our window. *)
  152.  
  153.   (*$I gemsubs.pas*)
  154.  
  155.   (* You must declare this function either in your accessory program (as here)
  156.      or in the GEMSUBS.PAS file: *)
  157.  
  158.   FUNCTION Menu_Register( id : integer ; VAR name : Str255 ) : integer ;
  159.     EXTERNAL ;
  160.  
  161.  
  162.   (* Open our window, if not already open.  If our window IS open already, just
  163.      make it the front window. *)
  164.  
  165.   PROCEDURE Do_Open ;
  166.  
  167.     BEGIN
  168.       (* Does our window already exist? *)
  169.       IF window <> No_Window THEN
  170.         Bring_To_Front( window )        (* Yes, just make it front window. *)
  171.       ELSE
  172.         BEGIN                           (* No, open a new window. *)
  173.           wind_name := ' Accessory Test ' ;
  174.           window := New_Window( G_Name|G_Close|G_Size|G_Move, wind_name,
  175.                                 0, 0, 0, 0 ) ;
  176.           Open_Window( window, 0, 0, 0, 0 )
  177.         END
  178.     END ;
  179.  
  180.  
  181.  
  182.   (* Close our window and delete it from the system. *)
  183.  
  184.   PROCEDURE Do_Close ;
  185.  
  186.     BEGIN
  187.       Close_Window( window ) ;
  188.       Delete_Window( window ) ;
  189.       window := No_Window
  190.     END ;
  191.  
  192.  
  193.  
  194.  (* Redraw an area of our window.  The area to redraw is passed in the
  195.     parameters x0, y0, w0, and h0.  For simplicity, we just draw a rectangle
  196.     of the same size as the area to redraw and draw an X in it.  This is also
  197.     interesting to watch since it shows exactly what redraw messages GEM is
  198.     sending. *)
  199.  
  200.   PROCEDURE Do_Redraw( handle, x0, y0, w0, h0 : integer ) ;
  201.  
  202.     VAR
  203.       x,            (* These four variables are used to hold the size of *)
  204.       y,            (* the current rectangle in the list for our window. *)
  205.       w,
  206.       h : integer ;
  207.  
  208.     BEGIN
  209.       Begin_Update ;          (* Tell GEM we are updating, *)
  210.       Hide_Mouse ;            (* and hide mouse so we don't mess up screen. *)
  211.       Paint_Color( White ) ;  (* We'll be clearing each rectangle w/ white. *)
  212.       (* This loop should look familiar, since it is copied out of the
  213.         Pascal manual, p. 5-115, except for correcting a couple of errors! *)
  214.       First_Rect( handle, x, y, w, h ) ;
  215.       WHILE (w <> 0) AND (h <> 0) DO
  216.         BEGIN
  217.           IF Rect_Intersect( x0, y0, w0, h0, x, y, w, h ) THEN
  218.             BEGIN
  219.               (* The only thing that's new is what we're drawing: *)
  220.               Set_Clip( x, y, w, h ) ;
  221.               Paint_Rect( x, y, w, h ) ;    (* First clear to white... *)
  222.               Frame_Rect( x, y, w, h ) ;    (* Then draw rectangle outline *)
  223.               Line( x, y, x+w-1, y+h-1 ) ;  (* and two lines to form an X. *)
  224.               Line( x+w-1, y, x, y+h-1 )
  225.             END ;
  226.           Next_Rect( handle, x, y, w, h ) ;
  227.         END ;
  228.       Show_Mouse ;              (* OK, we can redraw the mouse, too, *)
  229.       End_Update                (* and tell GEM we're finished! *)
  230.     END ;
  231.  
  232.  
  233.  
  234.  (* This next routine performs all events we receive from GEM.  Since we are
  235.     an accessory, we will never reach a state where we will stop running, so
  236.     the loop below (for each event we get) is infinite! *)
  237.  
  238.   PROCEDURE Event_Loop ;
  239.  
  240.     VAR
  241.       event, dummy : integer ;
  242.       msg : Message_Buffer ;
  243.  
  244.     BEGIN
  245.       WHILE true DO
  246.         BEGIN
  247.           (* Get one event-- we're only interested in messages. *)
  248.           event := Get_Event( E_Message, 0, 0, 0, 0,
  249.                         false, 0, 0, 0, 0, false, 0, 0, 0, 0,
  250.                         msg, dummy, dummy, dummy, dummy, dummy, dummy ) ;
  251.           CASE msg[0] OF
  252.             AC_Open:
  253.               IF msg[4] = menu_id THEN  (* If our menu item was selected, *)
  254.                 Do_Open ;               (* open the window! *)
  255.             AC_Close:
  256.              (* If we haven't already closed our window, pretend it's closed
  257.                 (because GEM is going to close it for us!)  Presumably, the
  258.                 program that was running when we were opened has finished. *)
  259.               IF (msg[4] = menu_id) AND (window <> No_Window) THEN
  260.                   window := No_Window ;
  261.             WM_Sized,       (* Allow any size or position on the screen. *)
  262.             WM_Moved:       (* (we really should have a minimum size!) *)
  263.               Set_WSize( msg[3], msg[4], msg[5], msg[6], msg[7] ) ;
  264.             WM_Closed:      (* User wants to close our window-- close it. *)
  265.               Do_Close ;
  266.             WM_Redraw:      (* Need to redraw a portion of our window. *)
  267.               Do_Redraw( msg[3], msg[4], msg[5], msg[6], msg[7] ) ;
  268.             WM_Topped:      (* Aha, user wants us to be front window! *)
  269.               Bring_To_Front( msg[3] ) ;
  270.           END
  271.         END
  272.     END ;
  273.  
  274.  
  275.  
  276.  (* Main routine-- initialize GEM, then insert our name into the "Desk" menu
  277.     and go to our event loop.  That routine will NEVER return!  That's why we
  278.     don't need an Exit_Gem call at the end of the program. *)
  279.  
  280.   BEGIN
  281.     ap_id := Init_Gem ;         (* We do need to save our application ID... *)
  282.     IF ap_id >= 0 THEN          (* that's a change from most programs. *)
  283.       BEGIN
  284.         (* Starting off with no window on the screen: *)
  285.         window := No_Window ;
  286.         (* Always put two spaces before the name of the accessory: *)
  287.         our_name := '  Sample Accessory' ;
  288.         (* Here is where we use the application ID number: *)
  289.         menu_id := Menu_Register( ap_id, our_name ) ;
  290.         Event_Loop ;
  291.       END
  292.   END.
  293.  
  294. GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGG